home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / bmain.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  11.6 KB  |  484 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include <stdio.h>
  13. #include <ctype.h>
  14. #include "hdr.h"
  15. #include "vars.h"
  16. #include "gvars.h"
  17. #include "libhdr.h"
  18. #include "segment.h"
  19. #include "ifile.h"
  20. #include "slot.h"
  21. #include "arithprots.h"
  22. #include "dclmapprots.h"
  23. #include "readprots.h"
  24. #include "dbxprots.h"
  25. #include "initprots.h"
  26. #include "blibprots.h"
  27. #include "libprots.h"
  28. #include "glibprots.h"
  29. #include "libfprots.h"
  30. #include "librprots.h"
  31. #include "libwprots.h"
  32. #include "g0aprots.h"
  33. #include "setprots.h"
  34. #include "miscprots.h"
  35. #include "gmiscprots.h"
  36. #include "bmainprots.h"
  37. #ifdef vms
  38. #define vms_BINDER
  39. #endif
  40.  
  41. #ifdef vms_BINDER
  42. /*
  43. #include descrip
  44. #include "adabind.h"
  45. */
  46. #endif
  47.  
  48. static void fold_upper(char *);
  49. static void bpreface();
  50. static void exitf(int);
  51.  
  52. /* Driver routine for ada gen */
  53. char *argname;
  54.  
  55. IFILE    *AISFILE, *AXQFILE, *STUBFILE, *LIBFILE, *TREFILE;
  56. FILE *MALFILE;
  57. int list_unit_0 = 0; /* set by '0' option to list unit 0 structure */
  58. int peep_option = 1; /* on for peep_hole optimization */
  59. int adacomp_option = 0; /* set if called from adacomp */
  60.  
  61. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  62. extern Segment   VARIANT_TABLE, FIELD_TABLE ;
  63. char *lib_name;
  64. #ifdef DEBUG
  65. extern int zpadr_opt; /* not for EXPORT */
  66. #endif
  67.  
  68. void main(int argc, char **argv)
  69. {
  70.     int        c, i, n, iot_level = 2;
  71.     int        errflg = 0, nobuffer = 0, mflag = 0;
  72.     extern int  optind;
  73.     extern char *optarg;
  74.     char    *t_name;
  75.     char    *fname, *tfname, *source_name;
  76.     int        r_trace = TRUE, w_trace = TRUE; /* trace modes for -f option */
  77. #ifdef vms_BINDER
  78.     int         status;
  79.     char        buffer[50];
  80.     short       rlength;
  81.     struct      dsc$descriptor_s entity_desc;
  82.     struct      dsc$descriptor_s value_desc;
  83. #endif
  84.  
  85.     AISFILE = (IFILE *)0;
  86.     AXQFILE = (IFILE *)0;
  87.     LIBFILE = (IFILE *)0;
  88.     STUBFILE = (IFILE *)0;
  89.     TREFILE = (IFILE *)0;
  90.  
  91.     MAINunit = "";
  92.     interface_files = "";
  93.  
  94.     while ((c = getopt (argc, argv, "c:g:f:m:i:")) != EOF)
  95.         /*
  96.          *    user:
  97.          *    c    set if called from adacomp (errors in msg format).
  98.          *    f    file i/o trace, followed by list of options
  99.          *        a    trace ais files
  100.          *        d    do not include descriptors in trace
  101.          *        n    do not include file numbers in trace
  102.          *        r    subsequent traces for reading only
  103.          *        t    trace tre files
  104.          *        w    subsequenc traces for writing only
  105.          *        (traces initially for both r and w, use of r or w
  106.          *        limits further files traces to just that mode)
  107.          *        1    set trace level to 1
  108.          *        2    set trace level to 2
  109.          *    g    debugging, followed by list of options:
  110.          *        0    show structure of unit 0
  111.          *        M    malloc trace (including init_sem)
  112.          *        b    do not buffer standard output
  113.          *        e    flag signalling errors in the parsing phase
  114.          *        g    list generated code
  115.          *        l    show line numbers in generated code
  116.          *        m    malloc trace (after init_sem)
  117.          *        z    call trapini to initialize traps
  118.          *      i   to specify object files and libraries for pragma interface
  119.          *      l    using library
  120.          *    m    main unit name
  121.          *      n    new library
  122.          */
  123.         switch (c) {
  124.         case 'c': 
  125.             adacomp_option++;
  126.             source_name = malloc(strlen(optarg)+1);
  127.             strcpy(source_name, optarg);
  128.             break;
  129.         case 'i':
  130.             interface_files = strjoin(interface_files, optarg);
  131.             interface_files = strjoin(interface_files, " ");
  132.             break;
  133.         case 'l': /* using existing library */
  134.             break;
  135.         case 'm': /* specify main unit name */
  136.             MAINunit = malloc(strlen(optarg)+1);
  137.             strcpy(MAINunit, optarg);
  138.             fold_upper(MAINunit);
  139.             break;
  140.         case 'n': /* indicates new library */
  141.             new_library = TRUE;
  142.             break;
  143. #ifdef DEBUG
  144.         case 'f':    /* process ifile trace options */
  145.             n = strlen(optarg);
  146.             for (i = 0; i < n; i++) {
  147.                 switch (optarg[i]) {
  148.  
  149.                 case 'o':
  150.                     /* turn off file offset trace */
  151.                     iot_off_info(0);
  152.                     break;
  153.                 case 'a':
  154.                     if (w_trace) iot_ais_w = iot_level;
  155.                     if (r_trace) iot_ais_r = iot_level;
  156.                     break;
  157.                 case 't':
  158.                     if (w_trace) iot_tre_w = iot_level;
  159.                     if (r_trace) iot_tre_r = iot_level;
  160.                     break;
  161.                 case 'l':
  162.                     if (w_trace) iot_lib_w = iot_level;
  163.                     if (r_trace) iot_lib_r = iot_level;
  164.                     break;
  165.                 case 'n': 
  166.                     iot_set_opt_number(0);
  167.                     break;
  168.                 case 'd': 
  169.                     iot_set_opt_desc(0); 
  170.                     break;
  171.                 case 'r': 
  172.                     w_trace= FALSE; 
  173.                     r_trace= TRUE; 
  174.                     break;
  175.                 case 'w': 
  176.                     r_trace = FALSE; 
  177.                     w_trace = TRUE; 
  178.                     break;
  179.                 case '1': 
  180.                     iot_level = 1; 
  181.                     break;
  182.                 case '2': 
  183.                     iot_level = 2; 
  184.                     break;
  185.                 }
  186.             }
  187.             break;
  188. #endif
  189.         case 'g': /* gen debug options */
  190.             n = strlen(optarg);
  191.             for (i = 0; i < n; i++) {
  192.                 switch((int)optarg[i]) {
  193. #ifdef DEBUG
  194.                 case 'a':
  195.                     zpadr_opt = 0; /* do not print addresses in zpadr */
  196.                     break;
  197. #endif
  198.                 case 'g':
  199.                     list_code++;
  200.                     break;
  201.                 case 'l':
  202.                     line_option++;
  203.                     break;
  204. #ifdef DEBUG
  205.                 case 'b': /* do not buffer output */
  206.                     nobuffer++;
  207.                     break;
  208.                 case 'd': /* force debugging output */
  209.                     debug_flag++;
  210.                     break;
  211.                 case 'e':
  212.                     errors = TRUE;
  213.                     break;
  214.                 case 'o': /* disable optimization (peep) */
  215.                     peep_option = 0;
  216.                     break;
  217.                 case 'm': /* malloc trace */
  218.                     mflag++;
  219.                     break;
  220.                 case '0': /* read trace including unit 0 */
  221.                     list_unit_0++;
  222.                     break;
  223.                 case 'z': 
  224.                     trapini();
  225.                     break;
  226. #endif
  227.                 }
  228.             }
  229.             break;
  230.         case '?':
  231.             errflg++;
  232.         }
  233. #ifdef IBM_PC
  234.     if (!adacomp_option) {
  235.         fprintf(stderr, "NYU Binder Version 1.7.2,");
  236.         fprintf(stderr, " Copyright (C) 1985-1987 by New York University\n");
  237.     }
  238. #endif
  239.     fname = (char *)0;
  240.     if (optind < argc)
  241.         fname = argv[optind];
  242.     /* if fname not given, get from environment. */
  243.     if (!errflg && fname == (char *)0) {
  244.         fname = getenv("ADALIB");
  245.         if (fname!= (char *)0 && !adacomp_option) {
  246. #ifdef IBM_PC
  247.             fprintf(stderr, "L");
  248. #else
  249.             fprintf(stderr, "l");
  250. #endif
  251.             fprintf(stderr, "ibrary defined by ADALIB: %s\n", fname);
  252.         }
  253.     }
  254.     if (fname == (char *)0 || errflg) {
  255.         fprintf (stderr, "Usage: adabind [-m main_unit] [library]\n");
  256.         exitp(RC_ABORT);
  257.     }
  258.     lib_name = emalloc(strlen(fname) + 1);
  259.     strcpy(lib_name, fname);
  260.     t_name = libset(lib_name); /* set library */
  261.     gen_option = FALSE; /* bind only */
  262.  
  263. #ifdef vms_BINDER
  264.     if (!adacomp_option) {
  265.         entity_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  266.         entity_desc.dsc$b_class = DSC$K_CLASS_S;
  267.         value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  268.         value_desc.dsc$b_class = DSC$K_CLASS_S;
  269.         value_desc.dsc$a_pointer = buffer;
  270.         value_desc.dsc$w_length = 50;
  271.         entity_desc.dsc$a_pointer = "C";
  272.         entity_desc.dsc$w_length = 1;
  273.         status = CLI$PRESENT(&entity_desc);
  274. #ifdef DEBUG
  275.         printf("C status %d\n", status);
  276. #endif
  277.         if (status & 1) {
  278.             status = CLI$GET_VALUE(&entity_desc, &value_desc, &rlength);
  279.             value_desc.dsc$a_pointer[rlength] = '\0';
  280.             adacomp_option++;
  281.             source_name  = strjoin(value_desc.dsc$a_pointer, "");
  282. #ifdef DEBUG
  283.             printf("C %s\n", source_name);
  284. #endif
  285.         }
  286.  
  287.  
  288.         entity_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  289.         entity_desc.dsc$b_class = DSC$K_CLASS_S;
  290.         value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  291.         value_desc.dsc$b_class = DSC$K_CLASS_S;
  292.         value_desc.dsc$a_pointer = buffer;
  293.         value_desc.dsc$w_length = 50;
  294.         entity_desc.dsc$a_pointer = "MAIN_UNIT";
  295.         entity_desc.dsc$w_length = 9;
  296.         status = CLI$PRESENT(&entity_desc);
  297. #ifdef DEBUG
  298.         printf("MAIN_UNIT status %d\n", status);
  299. #endif
  300.         if (status & 1) {
  301.             status = CLI$GET_VALUE(&entity_desc, &value_desc, &rlength);
  302.             value_desc.dsc$a_pointer[rlength] = '\0';
  303.             MAINunit = strjoin(value_desc.dsc$a_pointer, "");
  304.             fold_upper(MAINunit);
  305. #ifdef DEBUG
  306.             printf("MAIN_UNIT %s\n", MAINunit);
  307. #endif
  308.         }
  309.         entity_desc.dsc$a_pointer = "LIBRARY";
  310.         entity_desc.dsc$w_length = 7;
  311.         status = CLI$PRESENT(&entity_desc);
  312. #ifdef DEBUG
  313.         printf("LIBRARY status %d\n", status);
  314. #endif
  315.         if (status & 1) {
  316.             status = CLI$GET_VALUE(&entity_desc, &value_desc, &rlength);
  317.             value_desc.dsc$a_pointer[rlength] = '\0';
  318.             fname = strjoin(value_desc.dsc$a_pointer, "");
  319. #ifdef DEBUG
  320.             printf("LIBRARY %s\n", fname);
  321. #endif
  322.         }
  323.         lib_name = emalloc(strlen(fname) + 1);
  324.         strcpy(lib_name, fname);
  325.         t_name = libset(lib_name); /* set library */
  326.         gen_option = FALSE; /* bind only */
  327.     }
  328. #endif
  329.     tup_init(); /* initialize set and tuple procedures */
  330. #ifdef DEBUG
  331.     if (mflag) {
  332.         trace_malloc();
  333.         /* can't use strjoin to setup efopen arg as want trace ! */
  334.         /*MALFILE = efopen(strjoin(FILENAME, ".mas"), "w", "t"); */
  335.         tfname = malloc(strlen(fname) +4 + 1);
  336.         MALFILE = efopen(strcat(strcpy(tfname, fname), ".mag"), "w", "t");
  337.         free(tfname);
  338.     }
  339. #endif
  340.     FILENAME = (fname != (char *)0) ? strjoin(fname, "") : fname;
  341.  
  342.     PREDEFNAME = predef_env();
  343.     if (nobuffer) {
  344.         setbuf (stdout, (char *) 0);    /* do not buffer output (for debug) */
  345.     }
  346.     rat_init(); /* initialize arithmetic and rational package*/
  347.     dstrings_init(2048, 256); /* initialize dstrings package */
  348.     init_sem();
  349.     DATA_SEGMENT_MAIN = main_data_segment();
  350.     aisunits_read = tup_new(0);
  351.     init_symbols = tup_exp(init_symbols, seq_symbol_n);
  352.     for (i = 1; i <= seq_symbol_n; i++)
  353.         init_symbols[i] = seq_symbol[i];
  354.  
  355.     num_predef_units = init_predef();
  356.     /*
  357.      * When the separate compilation facility is being used all references to
  358.      * AIS files will be made via the directory in LIBFILE. AISFILENAME is set
  359.      * to a number.
  360.      */
  361.     if (new_library) 
  362.         AISFILENAME = "1";
  363.     else
  364.         AISFILENAME = lib_aisname(); /* retrieve name from library */
  365.     /* open the appropriate files using the suffix .axq for axq files and
  366.      * .trc for tree file. 
  367.      *
  368.      * Open MESSAGEFILE with suffixe ".msg" if a file name specified;
  369.      * otherwise, if a file name not required, and one is not given,
  370.      * used stderr.
  371.      */
  372.     AXQFILE  = ifopen(AISFILENAME, "axq", "w", "a", iot_ais_w, 0);
  373.     if (adacomp_option) {
  374.         MSGFILE  = efopenl(source_name, "msg", "a", "t");
  375.         /* unbuffer output for debugging purposes */
  376.         setbuf(MSGFILE, (char *) 0);
  377.     }
  378.     else {
  379.         MSGFILE = stdout;
  380.     }
  381.     bpreface();
  382.  
  383.     /* Code formerly procedure finit() in init.c is now put here directly */
  384.     if (!errors) {
  385.         write_glib();
  386.         cleanup_files();
  387.     }
  388.  
  389.     exitf(RC_SUCCESS);
  390. }
  391.  
  392. static void fold_upper(char *s)                                /*;fold_upper*/
  393. {
  394.     register char c;
  395.  
  396.     while (c = *s) {
  397.         if (islower(c)) *s = toupper(c);
  398.         s++;
  399.     }
  400. }
  401.  
  402. void fold_lower(char *s)                                        /*;fold_lower*/
  403. {
  404.     register char c;
  405.  
  406.     while (c = *s) {
  407.         if (isupper(c)) *s = tolower(c);
  408.         s++;
  409.     }
  410. }
  411.  
  412. static void bpreface()                                            /*;bpreface*/
  413. {
  414.     /* bpreface is version of preface for use with binder */
  415.  
  416.     int    i;
  417.     Tuple    aisread_tup;
  418.  
  419.     aisread_tup = tup_new(0);
  420.     initialize_1();
  421.     /* 1- Load PREDEF */
  422.  
  423.     TASKS_DECLARED = FALSE;
  424.     /* 2- Generate user program */
  425.  
  426.     initialize_2();
  427.  
  428.     ada_line = 9998;
  429.     /* if binding, make ais_read tupe correspond to library */
  430.     aisread_tup = tup_new(0);
  431.     for (i = 11; i <= unit_numbers; i++)
  432.         aisread_tup = tup_with(aisread_tup, pUnits[i]->name);
  433.  
  434. #ifdef EXPORT
  435.     list_code = 0;
  436. #endif
  437.     if (binder(aisread_tup))
  438.         store_axq(AXQFILE, unit_number_now);
  439.     ifclose(AXQFILE);
  440.     if (errors) {
  441. #ifdef DEBUG
  442.         user_info("Binding stopped");
  443. #endif
  444.         exitf(RC_ERRORS);
  445.     }
  446. }
  447.  
  448. static void exitf(int status)                                        /*;exitf*/
  449. {
  450.     /* exit after closing any open files */
  451.     ifoclose(AXQFILE);
  452.     ifoclose(LIBFILE);
  453.     ifoclose(STUBFILE);
  454.     exitp(status);
  455. }
  456.  
  457. void user_error(char *reason)                                    /*;user_error*/
  458. {
  459.     errors++;
  460.     if (adacomp_option) {
  461.         list_hdr(ERR_SEMANTIC);
  462.         fprintf(MSGFILE, " %s\n", reason);
  463.     }
  464.     else
  465.         printf(" %s\n", reason);
  466. }
  467.  
  468. void user_info(char *line)                                        /*;user_info*/
  469. {
  470.     /* In SETL USER_INFO macro is defined to be
  471.      * PRINTA(GENfile, INFORMATION, ada_line, 0, ada_line, 0, '    '+line)    endm;
  472.      * where the argument is always a unit_name passed to formatted name
  473.      * In C, we call user_info and fill in needed info
  474.      */
  475.  
  476.     if (adacomp_option) {
  477.         list_hdr(INFORMATION);
  478.         fprintf(MSGFILE, "%s\n", line);
  479.     }
  480.     else {
  481.         printf("%s\n", line);
  482.     }
  483. }
  484.